home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / gfxfx / rot9.pas < prev    next >
Pascal/Delphi Source File  |  1994-06-22  |  7KB  |  196 lines
  1.  
  2. { Aardige varriant... }
  3.  
  4. program _Rotation;
  5. { Rotating sphere in SVGA mode, by Bas van Gaalen, Holland, PD }
  6. uses
  7.   dos,crt,graph;
  8.  
  9. const
  10.   NofPoints = 75;
  11.   Speed = 2;
  12.   Xc : word = 0;
  13.   Yc : word = 0;
  14.   Zc : word = 100;
  15.   Parabole : array[0..255] of word = (
  16.     369,363,358,352,346,341,335,329,324,318,313,308,302,297,292,287,282,277,
  17.     271,267,262,257,252,247,242,238,233,228,224,219,215,210,206,202,197,193,
  18.     189,185,181,176,172,169,165,161,157,153,149,146,142,138,135,131,128,124,
  19.     121,118,115,111,108,105,102,99,96,93,90,87,84,82,79,76,73,71,68,66,63,
  20.     61,59,56,54,52,50,48,46,44,42,40,38,36,34,32,31,29,27,26,24,23,21,20,19,
  21.     17,16,15,14,13,12,11,10,9,8,7,6,5,5,4,4,3,2,2,2,1,1,1,0,0,0,0,0,0,0,0,0,
  22.     0,0,1,1,1,2,2,3,3,4,4,5,6,6,7,8,9,10,11,12,13,14,15,16,18,19,20,22,23,25,
  23.     26,28,29,31,33,34,36,38,40,42,44,46,48,50,52,55,57,59,62,64,66,69,71,74,
  24.     77,79,82,85,88,91,93,96,99,102,106,109,112,115,118,122,125,129,132,136,
  25.     139,143,146,150,154,158,161,165,169,173,177,181,185,190,194,198,202,207,
  26.     211,216,220,225,229,234,238,243,248,253,258,263,267,272,278,283,288,293,
  27.     298,303,309,314,320,325,330,336,342,347,353,359,364,370,376);
  28.  
  29. type
  30.   TabType = array[0..255] of integer;
  31.   PointRec = record
  32.                X,Y,Z : integer;
  33.              end;
  34.   PointPos = array[0..NofPoints] of PointRec;
  35.  
  36. var
  37.   SinTab : TabType;
  38.   Point : PointPos;
  39.  
  40. {----------------------------------------------------------------------------}
  41.  
  42. procedure Setvideo;
  43. var GrMd,GrDr : integer;
  44.  
  45. {$F+} function DetectVGA : Integer; begin DetectVGA := 2; end; {$F-}
  46.  
  47. begin
  48.   GrDr := InstallUserDriver('SVGA256',@DetectVGA);
  49.   GrDr := Detect; InitGraph(GrDr,GrMd,'i:\bgi');
  50. end;
  51.  
  52. {----------------------------------------------------------------------------}
  53.  
  54. procedure setpal(col,r,g,b : byte); assembler;
  55. asm
  56.   mov dx,03c8h
  57.   mov al,col
  58.   out dx,al
  59.   inc dx
  60.   mov al,r
  61.   out dx,al
  62.   mov al,g
  63.   out dx,al
  64.   mov al,b
  65.   out dx,al
  66. end;
  67.  
  68. {----------------------------------------------------------------------------}
  69.  
  70. procedure Init;
  71.  
  72. const
  73.   CoorTab : array[0..199,0..2] of integer = (
  74.     (-18,-9,-46),(-23,-30,33),(-3,7,-49),(13,-43,-22),(4,48,15),
  75.     (-4,17,-47),(-1,8,49),(47,15,11),(4,0,-50),(-3,1,50),(5,49,8),
  76.     (-48,13,8),(-34,-33,15),(-31,-12,37),(36,34,-8),(-1,23,45),
  77.     (0,5,-50),(25,40,18),(-40,30,5),(-45,-13,17),(0,-4,50),(-35,23,-27),
  78.     (-1,-42,-28),(-40,-1,30),(-20,-11,-45),(-2,-13,-48),(32,-26,28),
  79.     (33,-12,36),(-8,-19,-45),(28,2,-41),(-33,-22,-31),(12,-35,-34),
  80.     (-22,42,16),(-11,-22,-43),(1,-48,13),(-31,-9,38),(5,-7,49),
  81.     (-1,-1,-50),(-4,-42,27),(-15,5,-47),(-13,-37,-31),(18,34,32),
  82.     (10,-38,-31),(-22,42,16),(-46,-15,-13),(-6,-40,30),(11,28,-40),
  83.     (34,37,5),(2,2,-50),(41,25,-13),(-48,15,1),(-13,3,48),(-10,-48,11),
  84.     (-35,2,-36),(-3,13,-48),(-50,-6,0),(8,13,48),(35,31,-19),(25,33,28),
  85.     (-16,11,-46),(-7,43,25),(-45,-2,-23),(30,-4,-40),(3,-4,-50),
  86.     (-15,-46,11),(19,-19,-42),(19,14,44),(-39,10,30),(47,0,17),
  87.     (9,-20,45),(5,49,-9),(-43,-25,4),(45,-19,9),(25,-5,-43),(12,45,-19),
  88.     (28,-13,-39),(-6,9,49),(-41,-4,28),(-23,44,4),(-23,30,-33),
  89.     (18,34,31),(-34,-36,3),(-27,34,24),(-22,-33,30),(-2,32,39),
  90.     (18,-30,-36),(-2,-10,49),(-7,-49,5),(6,8,-49),(0,-2,-50),
  91.     (-4,20,-46),(3,4,-50),(-9,-8,-49),(3,-41,29),(-28,28,30),
  92.     (-8,-17,46),(-39,32,-4),(29,9,40),(40,-28,11),(-12,-18,-45),
  93.     (23,-6,-44),(10,7,-48),(13,16,45),(-5,47,-16),(29,15,-37),
  94.     (-31,-19,-34),(19,46,4),(6,-32,-38),(-13,8,48),(-35,-29,-21),
  95.     (23,10,43),(-25,-35,-26),(-3,3,-50),(18,-9,46),(23,-4,-44),
  96.     (8,2,-49),(48,-5,13),(-16,-4,47),(1,9,49),(1,44,24),(7,16,-47),
  97.     (-4,-10,-49),(17,-42,20),(47,3,-18),(-22,9,44),(5,-38,32),
  98.     (-34,-31,-20),(-12,48,7),(-10,-46,16),(-15,-22,-43),(14,-26,-40),
  99.     (2,-2,-50),(17,17,44),(-25,19,39),(-44,12,20),(-14,6,-47),
  100.     (40,26,15),(33,-33,17),(-41,-15,-24),(-39,-4,-31),(-21,44,-9),
  101.     (-10,23,-43),(7,2,-49),(16,-20,-43),(17,-41,24),(3,27,-42),
  102.     (-8,48,-12),(16,29,-37),(-21,-13,43),(-2,7,-50),(-35,-35,1),
  103.     (-4,7,-49),(-36,-19,29),(14,7,47),(32,-32,-21),(-12,4,-48),
  104.     (15,12,-46),(-18,-25,40),(-16,-30,36),(7,-10,49),(-31,-30,25),
  105.     (4,-50,4),(4,7,-49),(22,-6,-45),(-26,-2,43),(6,32,38),(13,-39,29),
  106.     (-22,-34,29),(43,24,9),(11,-30,39),(-2,35,35),(-33,19,-33),
  107.     (0,3,-50),(36,13,-32),(43,21,14),(41,-14,26),(17,-46,-8),
  108.     (-8,3,49),(-26,24,-35),(10,44,-21),(39,-22,22),(25,-5,-43),
  109.     (-4,5,-50),(-11,13,-47),(-8,-48,13),(-3,-12,48),(-4,-43,-26),
  110.     (-49,-10,-6),(-2,-2,-50),(19,25,-39),(-27,-30,-30),(-8,-8,49),
  111.     (6,11,48),(-26,-12,-41),(16,-24,-41),(30,-19,-35),(1,-11,-49),
  112.     (-1,-6,50),(11,-6,-48),(23,21,-39));
  113.  
  114. var
  115.   I : byte;
  116.  
  117. begin
  118.   for I := 0 to NofPoints do begin
  119.     Point[I].X := CoorTab[I,0];
  120.     Point[I].Y := CoorTab[I,1];
  121.     Point[I].Z := CoorTab[I,2];
  122.   end;
  123.   for I := 1 to 63 do setpal(I,I div 3,20+I div 2,I);
  124. end;
  125.  
  126. {----------------------------------------------------------------------------}
  127.  
  128. procedure Calcsinus(var SinTab : TabType); var I : byte; begin
  129.   for I := 0 to 255 do SinTab[I] := round(sin(2*I*pi/255)*128); end;
  130.  
  131. {----------------------------------------------------------------------------}
  132.  
  133. function Sinus(Idx : byte) : integer; begin
  134.   Sinus := SinTab[Idx]; end;
  135.  
  136. {----------------------------------------------------------------------------}
  137.  
  138. function Cosin(Idx : byte) : integer; begin
  139.   Cosin := SinTab[(Idx+192) mod 255]; end;
  140.  
  141. {----------------------------------------------------------------------------}
  142.  
  143. procedure Rotate;
  144.  
  145. const
  146.   Xstep = Speed;
  147.   Ystep = Speed;
  148.   Zstep = -Speed;
  149.  
  150. var
  151.   Xp,Yp : array[0..NofPoints] of word;
  152.   Xpos : word;
  153.   X,Y,Z,X1,Y1,Z1 : integer;
  154.   I,J,PhiX,PhiY,PhiZ : byte;
  155.   Xdiv : shortint;
  156.  
  157. begin
  158.   Xdiv := Speed; Xpos := 320; J := 128; PhiX := 0; PhiY := 0; PhiZ := 0;
  159.   repeat
  160.     while (port[$3da] and 8) <> 0 do;
  161.     while (port[$3da] and 8) = 0 do;
  162.     setpal(0,0,0,15);
  163.     for I := 0 to NofPoints do begin
  164.       if (Xp[I] < 640) and (Yp[I] < 480) then
  165.         putpixel(Xp[I],Yp[I],0);
  166.       X1 := (Cosin(PhiY)*Point[I].X-Sinus(PhiY)*Point[I].Z) div 128;
  167.       Y1 := (Cosin(PhiZ)*Point[I].Y-Sinus(PhiZ)*X1) div 128;
  168.       Z1 := (Cosin(PhiY)*Point[I].Z+Sinus(PhiY)*Point[I].X) div 128;
  169.       X  := (Cosin(PhiZ)*X1+Sinus(PhiZ)*Point[I].Y) div 128;
  170.       Y  := (Cosin(PhiX)*Y1+Sinus(PhiX)*z1) div 128;
  171.       Z  := (Cosin(PhiX)*Z1-Sinus(PhiX)*Y1) div 128;
  172.       Xp[I] := Xpos+(Xc*Z-X*Zc) div (Z-Zc);
  173.       Yp[I] := 55+Parabole[J]+(Yc*Z-Y*Zc) div (Z-Zc);
  174.       if (Xp[I] < 640) and (Yp[I] < 480) then
  175.         putpixel(Xp[I],Yp[I],32+round(Z/2));
  176.     end;
  177.     inc(Xpos,Xdiv);
  178.     if (Xpos < 55) or (Xpos > 585) then Xdiv := -Xdiv;
  179.     inc(J,Speed);
  180.     inc(PhiX,Xstep);
  181.     inc(PhiY,Ystep);
  182.     inc(PhiZ,Zstep);
  183.     setpal(0,0,0,0);
  184.   until keypressed;
  185. end;
  186.  
  187. {----------------------------------------------------------------------------}
  188.  
  189. begin
  190.   Setvideo;
  191.   Init;
  192.   Calcsinus(SinTab);
  193.   Rotate;
  194.   textmode(lastmode);
  195. end.
  196.